package Waya::SGF;

use strict;
use warnings;
use Carp;
use Waya::Node;
use Waya::Variation;
use Waya::Coordinate;
use Waya::Property::Label;
use Waya::Constants ':traverse';
use Waya::Rank;
use Waya::SGFParser;
use Waya::Bounds;

our $VERSION = '0.01';

our $should_convert_properties = 1;

sub new {
    my ($class, $sgf) = @_;
    $sgf =~ s/[\x{0d}\x{0a}]/ /g;

    my $self = sgf_parse($sgf) or croak "Couldn't parse SGF file\n";
    _sew($self);
    $self->_init_traverse_node;
    $self;
} 


sub new_from_file {
    my ($class, $filename) = @_;
    open my $fh, $filename or die "can't open $filename: $!\n";
    my $sgf = do { local $/; <$fh> };
    close $fh or die "can't close $filename: $!\n";
    $class->new($sgf);
}


sub write_file {
    my ($self, $original_filename, $new_filename, %args) = @_;

    unless (($original_filename ne $new_filename) || $args{nobak}) {
        my $bakname = $original_filename . '~';
        rename $original_filename, $bakname or
            die "can't mv $original_filename $bakname: $!\n";
    }

    open my $fh, ">$new_filename" or
        die "can't open $new_filename for writing: $!\n";
    if (defined (local $_ = $self->game_info_node->{_header})) {
        1 while chomp;
        print $fh "$_\n" if length;
    }
    print $fh $self->as_sgf;
    close $fh or die "can't close $new_filename: $!\n";
}


sub dump {
    my $self = shift;
    require Data::Dumper;
    no warnings 'once';
    $Data::Dumper::Indent = 1;
    print Data::Dumper->Dumper($self);
}


sub _sew {
    my $self = shift;
    $self->[0]->{moves_to_first_variation} = 0;
    for (0..@$self) { 
        if (ref $self->[$_] eq "Waya::Variation") {
           $self->[0]->{moves_to_first_variation} ||= $_;
           _sew($_) for $self->[$_]->variations;
        } else {
            $self->[$_]->{next} = $self->[$_+1];
        }
    }
}


sub _init_traverse_node {
    my $self = shift;

    $self->game_info_node->{_is_game_info_node} = 1;

    $self->traverse_node(sub {
            my $node = shift;
            my $next = $node->{next};
            return RC_CONTINUE unless defined $next;
            
            if (ref $next eq 'Waya::Node') {
                $next->{prev} = $node;
            } elsif (ref $next eq 'Waya::Variation') {
                $_->[0]->{prev} = $node for $next->variations;
            } else {
                die sprintf "can't handle next node of type %s", ref $next;
            }
            return RC_CONTINUE;
    });

    if ($should_convert_properties) {
        for my $property (qw/WR BR/) {
            next unless exists $self->game_info_node->{$property};
            $self->game_info_node->{$property} =
                Waya::Rank->new(rank => $self->game_info_node->{$property});
        }

        $self->traverse_node(sub {
                my $node = shift;
                for my $key (qw/B W AB AW AE MA CR SQ TR VW TB TW/) {
                    next unless $node->{$key};
                    $_ = Waya::Coordinate->new_from_sgf_coordinate($_) for
                        ref $node->{$key} eq 'ARRAY' ?
                        @{ $node->{$key} } : $node->{$key}
                }

                if ($node->{LB}) {
                    $_ = Waya::Property::Label->new_from_sgf_label($_) for
                        ref $node->{LB} eq 'ARRAY'
                            ? @{ $node->{LB} }
                            : $node->{LB}
                }
                return RC_CONTINUE;
        });
    }
}


# Game info methods
sub game_name  { shift->[0]->{GN} }
sub date       { shift->[0]->{DT} }
sub time       { shift->[0]->{DT} }
sub white      { shift->[0]->{PW} }
sub black      { shift->[0]->{PB} }
sub white_rank { shift->[0]->{WR} }
sub black_rank { shift->[0]->{BR} }
sub komi       { shift->[0]->{KM} }
sub size       { shift->[0]->{SZ} || 19 }
sub move       { $_[0]->[$_[1]] }


sub game_info_node { shift->[0] }


sub as_sgf { sprintf '(%s)' => $_[0]->move(0)->as_sgf }


# callback on all nodes found in the tree (including variations)
sub traverse_node {
    my ($self, $code) = @_;
    $self->move(0)->traverse_node($code);
}


# callback on all coordinates found in the tree
sub traverse_coord {
    my ($self, $code) = @_;
    $self->move(0)->traverse_coord($code);
}


sub strip_variations {
    my $self = shift;
    $self->move(0)->strip_variations;
}


# e.g., resize(19, 'SE') keeps the stones' distance relative to the south-east
# corner

sub resize {
    my ($self, $new_size, $anchor) = @_;
    my $size_diff = $new_size - $self->size;
    $self->game_info_node->{SZ} = $new_size;

    return unless defined($anchor) && length($anchor);

    # dx = horizontal translation (delta x)
    # dy = vertical translation (delta y)
    my ($dx, $dy);

    if ($anchor eq 'NW' || $anchor eq 'N' || $anchor eq 'W') {
        $dx = 0;
        $dy = 0;
    } elsif ($anchor eq 'NE' || $anchor eq 'E') {
        $dx = $size_diff;
        $dy = 0;
    } elsif ($anchor eq 'SW' || $anchor eq 'S') {
        $dx = 0;
        $dy = $size_diff;
    } elsif ($anchor eq 'SE') {
        $dx = $size_diff;
        $dy = $size_diff;
    } else {
        die "no such anchor: $anchor\n";
    }

    $self->traverse_coord(sub {
        $_[0]->translate($dx, $dy);
        RC_CONTINUE;
    }) if $dx || $dy;
}


# find out which sides a file's collective coordinates touch; useful for
# automatic resizing.

sub get_anchor {
    my $self = shift;
    my $size = $self->size;
    my %seen;
    $self->traverse_coord(sub {
            my $coord = shift;
            $seen{W}++ if $coord->x == 1;
            $seen{E}++ if $coord->x == $size;
            $seen{N}++ if $coord->y == 1;
            $seen{S}++ if $coord->y == $size;
            return RC_CONTINUE;
    });

    if (($seen{W} && $seen{E}) || ($seen{N} && $seen{S})) {
        die sprintf "too many anchors: %s\n", join '' => keys %seen;
    }

    join '' => map { $seen{$_} ? $_ : '' } qw/N S W E/;
}


sub get_bounds {
    my $self = shift;
    my ($left, $right, $top, $bottom) = (0, 0, 0, 0);

    $self->traverse_node(sub {
        my $node = shift;
        for my $prop (qw/B W AB AW/) {
            next unless defined $node->{$prop} && length($node->{$prop});
            for my $coord (ref $node->{$prop} eq 'ARRAY'
                ? @{ $node->{$prop} } : $node->{$prop}) {

                my $x = $coord->x;
                my $y = $coord->y;
                $_ ||= $x for $left, $right;
                $_ ||= $y for $top,  $bottom;

                if ($x < $left)   { $left   = $x }
                if ($x > $right)  { $right  = $x }
                if ($y < $top)    { $top    = $y }
                if ($y > $bottom) { $bottom = $y }
            }
        }
        return RC_CONTINUE;
    });

    # Now we have the boundaries of the stones played. Leave two empty lines
    # on each sides.

    $_ -= 2 for $left, $top;
    $_ += 2 for $right, $bottom;

    # don't leave out just border lines
    $left   = 1           if $left <= 2;
    $right  = $self->size if $right >= $self->size - 1;
    $top    = 1           if $top <= 2;
    $bottom = $self->size if $bottom >= $self->size - 1;

    Waya::Bounds->new(
        left   => $left,
        right  => $right,
        top    => $top,
        bottom => $bottom,
    );
}


1;
